unit PasFileParser;

interface

uses
  Contnrs,
  SysUtils,
  Classes,
  StrUtils,
  JclFileUtils,
  JclStrings;

const
  S_IMPLEMENTATION = 'implementation';
  S_INTERFACE = 'interface';
  S_END = 'end';
  S_USES = 'uses';

type
  TPasTypeKind = (ptkClass, ptkEnum);

  TPasFile = class;
  TPasUsesItem = class;
  TPasType = class;
  TPasClass = class;
  TPasEnum = class;
  TPasFileSection = class;

  TPasType = class abstract
  public
    class function Kind: TPasTypeKind; virtual; abstract;  
  end;

  TPasClass = class(TPasType)
  public
    class function Kind: TPasTypeKind; override;
  end;

  TPasEnum = class(TPasType)
  public
    class function Kind: TPasTypeKind; override;
  end;

  TPasFileSection = class
  strict private
    fTypes: TObjectList;
    fPasFile: TPasFile;
    fUseses: TObjectList;
  private
    constructor Create(const aPasFile: TPasFile);
  public
    destructor Destroy; override;
    property Types: TObjectList read fTypes;
    property Useses: TObjectList read fUseses;
  end;

  TPasFile = class
  strict private
    fImpl: TPasFileSection;
    fIntf: TPasFileSection;
    fFileName: TFileName;
  private
    fUnitName: string;
    constructor Create(const aFileName: TFileName);
  public
    destructor Destroy; override;
    property Impl: TPasFileSection read FImpl;
    property Intf: TPasFileSection read FIntf;
    property UnitName: string read fUnitName;
  end;

  TPasUsesItem = class
  private
    fName: string;
    fPasFile: TPasFile;
  public
    constructor Create(const aName: string);
    property Name: string read fName;
    property PasFile: TPasFile read fPasFile;
  end;

  TPasFileParser = class
  strict private
    class procedure ReadSection(const aSectionContent: string; const aSection: TPasFileSection);
  public
    class function Parse(const aFileName: TFileName): TPasFile;
  end;

function FindKeyword(const aKeyword: string; const aSource: string; const From: Integer = 1): Integer;
procedure RemovePasComments(var aContent: string);
function IsKeywordSeparator(const c: Char): Boolean;
procedure SplitString(const aSource: string; const aSeparators: TSysCharSet; const Result: TStrings); 

implementation

procedure RemovePasComments(var aContent: string);
var
  lPrev, ind1, ind2, l: Integer;
begin
  lPrev := 1;
  while lPrev > 0 do
  begin
    ind1 := PosEx('//', aContent, lPrev);
    ind2 := ind1 + 1;
    l := Length(aContent);
    while (not (aContent[ind2] in [#13, #10])) and (ind2 < l) do
      Inc(ind2);
    Delete(aContent, ind1, ind2 + 2 - ind1);
    lPrev := ind1;
  end;

  // TODO: This part of code working a bit incorrect - it removes idefs and compilation directives
  lPrev := 1;
  while lPrev > 0 do
  begin
    ind1 := PosEx('{', aContent, lPrev);
    ind2 := ind1 + 1;
    l := Length(aContent);
    while (aContent[ind2] <> '}') and (ind2 < l) do
      Inc(ind2);
    Delete(aContent, ind1, ind2 + 1 - ind1);
    lPrev := ind1;
  end;
end;

function IsKeywordSeparator(const c: Char): Boolean;
begin
  Result := (not CharIsAlpha(c)) and (c <> '_')
end;

procedure SplitString(const aSource: string; const aSeparators: TSysCharSet; const Result: TStrings);
var
  i, pi: Integer;
  f: Boolean;
begin
  pi := -1;
  f := False;
  for i := 1 to Length(aSource) do
  begin
    if aSource[i] in aSeparators then
    begin
      if f then
      begin
        Result.Add(Copy(aSource, pi, i - pi));
        pi := i;
        f := False;
      end
    end
    else
    begin
      if not f then
      begin
        pi := i;
        f := True;
      end;
    end;
  end;
  if f then
    Result.Add(Copy(aSource, pi, MaxInt));
end;

function FindKeyword(const aKeyword: string; const aSource: string; const From: Integer = 1): Integer;
var
  ind, l: Integer;
begin
  ind := From;
  l := Length(aSource);
  while ind > 0 do
  begin
    Result := PosEx(aKeyword, aSource, ind);
    if Result > 0 then
    begin
      ind := Result + Length(aKeyword);
      if (Result = 1) then // at start of source
      begin
        if IsKeywordSeparator(aSource[ind]) then
          Exit;
      end
      else
      if (Result > 1) and (ind > l) then // at end of source
      begin
        if IsKeywordSeparator(aSource[Result - 1]) then
          Exit;
      end
      else // at the middle of source
      begin
        if IsKeywordSeparator(aSource[Result - 1]) and IsKeywordSeparator(aSource[ind]) then
          Exit;
      end;

      ind := Result + 1;
    end
    else
      Break;
  end;
  Result := -1;
end;

procedure ExtractSections(const aContent: string; out aIntf, aImpl: string);
var
  intf, impl: Integer;
begin
  intf := FindKeyword(S_INTERFACE, aContent);
  if intf > 0 then
  begin
    Inc(intf, Length(S_INTERFACE));
    impl := FindKeyword(S_IMPLEMENTATION, aContent, intf + Length(S_INTERFACE));
    if impl > 0 then
    begin
      aIntf := Copy(aContent, intf, impl - intf);

      Inc(impl, Length(S_IMPLEMENTATION));
      intf := PosEx(S_END + '.', aContent, impl); // TODO + '.' is not completely correct. File can be ended with 'end   .'
      if intf > 0 then
      begin
        aImpl := Copy(aContent, impl, intf - impl);  
      end
      else
        aIntf := '';

      Exit;
    end;
  end;

  aIntf := '';
  aImpl := '';
end;

{ TPasEnum }

class function TPasEnum.Kind: TPasTypeKind;
begin
  Result := ptkEnum;
end;

{ TPasClass }

class function TPasClass.Kind: TPasTypeKind;
begin
  Result := ptkClass;
end;

{ TPasFileSection }

constructor TPasFileSection.Create(const aPasFile: TPasFile);
begin
  fPasFile := aPasFile;
  fTypes := TObjectList.Create(True);
  fUseses := TObjectList.Create(True);
end;

destructor TPasFileSection.Destroy;
begin
  FreeAndNil(fUseses);
  FreeAndNil(fTypes);
  inherited;
end;

{ TPasFile }

constructor TPasFile.Create(const aFileName: TFileName);
begin
  fFileName := aFileName;
  fIntf := TPasFileSection.Create(Self);
  fImpl := TPasFileSection.Create(Self);
end;

destructor TPasFile.Destroy;
begin
  FreeAndNil(fImpl);
  FreeAndNil(fIntf);
  inherited;
end;

{ TPasFileParser }

class function TPasFileParser.Parse(const aFileName: TFileName): TPasFile;
var
  lContent, lImpl, lIntf: string;
begin
  Result := TPasFile.Create(aFileName);
  try
    lContent := FileToString(aFileName);
    RemovePasComments(lContent);
    Result.fUnitName := PathExtractFileNameNoExt(aFileName);

    ExtractSections(lContent, lIntf, lImpl);

    ReadSection(lIntf, Result.Intf);
    ReadSection(lImpl, Result.Impl);
    
//    SaveFileContent(aFileName + '.pas', lContent);
  except
    FreeAndNil(Result);
  end;
end;

class procedure TPasFileParser.ReadSection(const aSectionContent: string; const aSection: TPasFileSection);
var
  ind, ind2: Integer;
  lUses: string;
  lUs: TStringList;
begin
  ind := FindKeyword(S_USES, aSectionContent);
  if ind > 0 then
  begin
    Inc(ind, Length(S_USES));
    ind2 := PosEx(';', aSectionContent, ind);
    if ind2 > 0 then
    begin
      lUses := Copy(aSectionContent, ind, ind2 - ind);
      lUs := TStringList.Create;
      try
        SplitString(lUses, [' ', #10, #13, #9, ','], lUs);
        for ind := 0 to lUs.Count - 1 do
        begin
          aSection.Useses.Add(TPasUsesItem.Create(lUs[ind]));
        end;
      finally
        lUs.Free;
      end;
    end;   
  end;
end;

{ TPasUsesItem }

constructor TPasUsesItem.Create(const aName: string);
begin
  fName := aName;
end;

procedure TestStringSplit;

  procedure CheckList(const aList: TStrings; const expected: array of string);
  var
    i: Integer;
  begin
    Assert(aList.Count = High(expected) + 1, 'Invalid count of values');
    for i := 0 to aList.Count - 1 do
    begin
      Assert(aList[i] = expected[i], 'Invalid value');
    end;
  end;

var
  s: TStringList;
begin
  s := TStringList.Create;
  try
    SplitString(' a b c d d', [' '], s);
    CheckList(s, ['a', 'b', 'c', 'd', 'd']);

    s.Clear;
    SplitString('    ', [' '], s);
    CheckList(s, []);

    s.Clear;
    SplitString('abc', [' '], s);
    CheckList(s, ['abc']);

    s.Clear;
    SplitString(' a b   c  d   d  ', [' '], s);
    CheckList(s, ['a', 'b', 'c', 'd', 'd']);
  finally
    s.Free;
  end;
end;
//
//initialization
//  TestStringSplit;

end.
